home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / zindent7.zip / ZINDSK.INC < prev    next >
Text File  |  1987-03-30  |  10KB  |  356 lines
  1. (***************************************************************)
  2. (*                                                             *)
  3. (* Include File of Procedures                                  *)
  4. (* System Disk Utility,  v. 0830am, sun, 28.Mar.87, Glen Ellis *)
  5. (*                                                             *)
  6. (***************************************************************)
  7.  
  8.  
  9. (* procedure *******************************************************)
  10. (* Say File List,     v. 0126pm, mon, 01.Sept.86, Glen Ellis       *)
  11.  
  12. procedure pSayFileList;
  13.  
  14. (* display list of filenames from Text File input *)
  15. begin
  16.    writeln;
  17.    FOR x := 1 to SysInSourceMax do
  18.    begin
  19.       writeln('SysInSource[',x,'] = ', SysInSource[x] );
  20.    end;
  21.    writeln;
  22. end;
  23.  
  24.  
  25. (* procedure **************************************************)
  26. (* System Parse .inc, v. 0700pm, mon, 15.Dec.86, Glen Ellis   *)
  27.  
  28. procedure pSysParse( parseFile : Thestr ; var PgmMod : string2 ;
  29. var PgmModStrL, PgmModStrR : string2 );
  30.  
  31. (* SysInFilename contains the real SourceFileName *)
  32. (* parse for ?TYP
  33. (*   OutLine(.TXT) /  dBASE(.CMD.PRG) / Pascal(.PAS.INC.PRO.FUN)
  34. (* default to .$$$ (which is written normally any way)
  35. (* set SysMode flag to ('  ') or (OL) or (TP) or (DB)
  36. (*---------------------------------------------------------*)
  37.  
  38. (* parseFile    = parseFileName to be parsed for .TYP mode
  39. (* Mode     = flag for system use
  40. (* ModStrL  = prefix for comment line
  41. (* ModStrR  = Suffix for comment line
  42. *)
  43.  
  44. var
  45. i  : nbr;
  46. uTYPArray : array[0..12] of string4;
  47. uTYPe     : string4;
  48. uLine     : THEstr;
  49.  
  50. begin (* proc *)
  51.  
  52.    uType := '    ';
  53.  
  54.    (* enter only if SysPgmMod is '  ' *)
  55.    (* pgmMod   := '  '; *)
  56.  
  57.    PgmModStrL  := '  ';
  58.    PgmModStrR  := '  ';
  59.  
  60.    (* OutLine *)
  61.    uTYPArray[0] := '.TXT';
  62.  
  63.    (* dBASE *)
  64.    uTYPArray[1] := '.CMD';
  65.    uTYPArray[2] := '.PRG';
  66.  
  67.    (* Turbo Pascal *)
  68.    uTYPArray[3] := '.PAS';
  69.    uTYPArray[4] := '.INC';
  70.    uTYPArray[5] := '.FUN';
  71.    uTYPArray[6] := '.PRO';
  72.    uTYPArray[7] := '.BOX';
  73.  
  74.    (* ZinLine,ZinFile, and ZinUser also trap for this error. *)
  75.    IF length(parseFile) = 0 then
  76.    begin
  77.       writeln('No FileName Entered');
  78.       pAlarm;
  79.       pKeyPressed;
  80.    end;
  81.  
  82.    (*-------------------*)
  83.  
  84.    pAllCaps(parseFile);    (* prep for parse for filename *)
  85.  
  86.    x  := pos('.',parseFile);
  87.  
  88.    IF x < 1 then   (* emergency trap *)
  89.    begin
  90.       parseFile := '.###';
  91.       x := 1;
  92.    end;
  93.  
  94.    uTYPe := copy(parseFile,x,4);
  95.  
  96.    uLine := uTYPe;
  97.    pAllCaps(uLine);
  98.  
  99.    (*------*)
  100.    (* OutLine , general catch-all *)
  101.    (* KeyWord parser procedure has not neen written for OutLine. *)
  102.    (* potential use is for Assembler Source Code.  *)
  103.  
  104. (* for x :=  y to z  do  *)
  105.    begin
  106.       IF uTYPe =  uTYPArray[0] then
  107.       (* there is no key.inc module for this. User can write one *)
  108.       begin
  109.          PgmMod := 'OL';
  110.          PgmModStrL  := '; ';  (* comment delimiters *)
  111.          PgmModStrR  := ' ;';
  112.       end;
  113.    end;
  114.  
  115.  
  116.    for x := 1 to 2 do
  117.    begin
  118.       (* dBASE *)
  119.       IF uTYPe =  uTYPArray[x] then
  120.       begin
  121.          PgmMod := 'DB';
  122.          PgmModStrL  := '* ';  (* comment delimiters *)
  123.          PgmModStrR  := ' *';
  124.       end;
  125.    end;
  126.  
  127.    (* Turbo Pascal *)
  128.    for x := 3 to 7 do
  129.    begin
  130.       IF uTYPe =  uTYPArray[x] then
  131.       begin
  132.          PgmMod := 'TP';
  133.          PgmModStrL := '(*';   (* comment delimiters *)
  134.          PgmModStrR := '*)';
  135.       end;
  136.    end;
  137.  
  138. end; (* proc *)
  139.  
  140.  
  141. (* procedure ************************************************************)
  142. (* Input/Output Error Checking, v. 0700pm, sun, 21.Sept.86, Glen Ellis  *)
  143.  
  144. procedure pIOCheck( var IOcheck : lgc );
  145.  
  146. (* develop no halt for trying to read non-existent file *)
  147. (* need skip read loop, continue program if no file found *)
  148.  
  149. var
  150. Ch : Char;
  151. IOReadErr : lgc;
  152.  
  153. begin (* proc *)
  154.  
  155.    IOVal := IOresult;
  156.    IOErr := (IOVal <> 0);
  157.  
  158.    (* GotoXY(1,23); ClrEol; *)
  159.  
  160.    IF IOErr then
  161.    begin
  162.  
  163.       Write(Chr(7));
  164.       writeln('---------------------------');
  165.       writeln('       I/O    Error        ');
  166.       writeln('---------------------------');
  167.  
  168.       (*    pAlarm; (* SysUtl.inc *)
  169.  
  170.       CASE IOVal of
  171.  
  172.          $01  :  Write('  File does not exist');
  173.          $02  :  Write('  File not open for input');
  174.          $03  :  Write('  File not open for output');
  175.          $04  :  Write('  File not open');
  176.          $05  :  Write('  Can''t read from this file');
  177.          $06  :  Write('  Can''t write to this file');
  178.          $10  :  Write('  Error in numeric format');
  179.          $20  :  Write('  Operation not allowed on a logical device');
  180.          $21  :  Write('  Not allowed in direct mode');
  181.          $22  :  Write('  Assign to standard files not allowed');
  182.          $90  :  Write('  Record length mismatch');
  183.          $91  :  Write('  Seek beyond end of file');
  184.          $96  :  Write('  Strange undefined IO error, not in manual !');
  185.          $99  :  Write('  Unexpected end of file');
  186.          $F0  :  Write('  Disk write error');
  187.          $F1  :  Write('  Directory is full');
  188.          $F2  :  Write('  File size overflow');
  189.          $FF  :  Write('  File disappeared')
  190.          else    Write('  Unknown I/O error:  ',IOVal:3)
  191.       end; (* case *)
  192.  
  193.       writeln;
  194.  
  195.       (* if no read file, then skip whole "core" loop *)
  196.       (* this is probably NOT a FATAL error.          *)
  197.  
  198.       IF IOval = $01 then
  199.       begin
  200.          (* IOcheck is tested/prompted in main program *)
  201.          IOcheck := false ;
  202.          IF SysPgmTrace then
  203.          begin
  204.             (* inform the user, and keep going *)
  205.             writeln('  IOcheck = ',IOcheck,' : IOval = ',IOval,chr(7));
  206.             pDelay4;
  207.          end;
  208.       end;
  209.  
  210.       (* other errors May Be Fatal, so allow user to exit *)
  211.  
  212.       IF IOval > $01 then  (**)
  213.       begin
  214.  
  215.                Repeat
  216.                   Read(Kbd,Ch)
  217.                Until Not KeyPressed;
  218.  
  219.                writeln('  User Interrupt allowed ');
  220.                Write(^M,'  Terminate (Y/N)? ');
  221.                Read(Kbd,Ch);
  222.  
  223.                IF UpCase(Ch)='Y' Then
  224.                begin
  225.                   WriteLn('Y');
  226.                   (* Write(SysOutFile,'  User Terminated on pIOcheck error');*)
  227.                   Close(SysOutFile);
  228.                   Close(SysInFile);
  229.                   Halt;
  230.                end
  231.                Else Write(^M,'                ',^M);
  232.  
  233.       end; (* IOval *)
  234.    end; (* IOerr *)
  235. end; (* proc *)
  236.  
  237.  
  238. (* procedure ****************************************************)
  239. (* Start System Files,   v. 0752pm, thu, 18.Sep.86, Glen Ellis *)
  240.  
  241. procedure pSysStartFiles( var IOcheck : lgc );
  242.  
  243. (* borrows system global vars *)
  244. (* SysFile 0,1,2, SysIOcheck flag*)
  245.  
  246. var
  247. x : integer;
  248.  
  249. begin (* proc *)
  250.  
  251.    (* position of .typ *)
  252.    x := pos('.',SysInFileName);
  253.  
  254.    (* file.BAK *)
  255.    SysFile0 := copy(SysInFileName,1,x);
  256.    SysFile0 := concat(SysFile0,'BAK');
  257.  
  258.    (* file.CMD *)
  259.    SysFile1 := SysInFileName;
  260.  
  261.    (* file.$$$ *)
  262.    SysFile2 := copy(SysInFileName,1,x);
  263.    SysFile2 := concat(SysFile2,'$$$');
  264.  
  265.    IF SysUserTrace then
  266.    begin
  267.       pSaySysFiles;   (* SysUtl.inc *)
  268.       IF SysPgmTrace then pDelay1;
  269.    end;
  270.  
  271.    IF SysUserTrace then writeln('  Assign Read-File  = ',SysFile1);
  272.    ASSIGN( SysInFile, SysFile1 );
  273.  
  274.    IF SysUserTrace then writeln('  Reset   Read      = ',SysFile1);
  275.    (*$I-*); RESET( SysInFile ); (*$I+*);
  276.    pIOcheck( IOcheck );
  277.  
  278.    IF IOcheck  then (* able to read from Source file *)
  279.    begin
  280.  
  281.       IF SysUserTrace then writeln('  Assign Write-File = ',SysFile2);
  282.       ASSIGN( SysOutFile, SysFile2 );
  283.  
  284.       IF SysUserTrace then writeln('  ReWrite  Write    = ',SysFile2);
  285.       (*$I-*); REWRITE( SysOutFile ); (*$I+*);
  286.       pIOcheck( IOcheck );
  287.  
  288.    end; (* IOcheck *)
  289.  
  290. end; (* proc *)
  291.  
  292.  
  293.  
  294. (* Procedure *********************************************************)
  295. (* Rename System Files,  v. 0830pm, wed, 17.Sep.86, Glen Ellis *)
  296.  
  297. procedure pSysReName( var IOcheck : lgc );
  298.  
  299. begin (* proc *)
  300.  
  301.    (* borrows syste